home *** CD-ROM | disk | FTP | other *** search
- VERSION 4.00
- Begin VB.Form ShowApfForm
- Appearance = 0 'Flat
- BackColor = &H00C0C0C0&
- Caption = "Show APF"
- ClientHeight = 6060
- ClientLeft = 1410
- ClientTop = 630
- ClientWidth = 6015
- BeginProperty Font
- name = "MS Sans Serif"
- charset = 1
- weight = 700
- size = 8.25
- underline = 0 'False
- italic = 0 'False
- strikethrough = 0 'False
- EndProperty
- ForeColor = &H80000008&
- Height = 6750
- KeyPreview = -1 'True
- Left = 1350
- LinkTopic = "Form1"
- ScaleHeight = 6060
- ScaleWidth = 6015
- Top = 0
- Width = 6135
- Begin VB.TextBox YmaxText
- Height = 285
- Left = 5160
- TabIndex = 13
- Text = "7"
- Top = 5760
- Width = 855
- End
- Begin VB.TextBox YminText
- Height = 285
- Left = 3600
- TabIndex = 11
- Text = "-7"
- Top = 5760
- Width = 855
- End
- Begin VB.TextBox XmaxText
- Height = 285
- Left = 2040
- TabIndex = 9
- Text = "7"
- Top = 5760
- Width = 855
- End
- Begin VB.TextBox XminText
- Height = 285
- Left = 480
- TabIndex = 7
- Text = "-7"
- Top = 5760
- Width = 855
- End
- Begin VB.TextBox PhiText
- Height = 285
- Left = 3600
- TabIndex = 6
- Text = "0.1570"
- Top = 5400
- Width = 855
- End
- Begin VB.TextBox ThetaText
- Height = 285
- Left = 2040
- TabIndex = 4
- Text = "0.6283"
- Top = 5400
- Width = 855
- End
- Begin VB.TextBox RText
- Height = 285
- Left = 480
- TabIndex = 2
- Text = "10"
- Top = 5400
- Width = 855
- End
- Begin VB.PictureBox Pict
- AutoRedraw = -1 'True
- Height = 5295
- Left = 0
- ScaleHeight = -14
- ScaleLeft = -7
- ScaleMode = 0 'User
- ScaleTop = 7
- ScaleWidth = 15.926
- TabIndex = 0
- Top = 0
- Width = 6015
- End
- Begin VB.Label Label1
- Caption = "Ymax"
- Height = 255
- Index = 6
- Left = 4680
- TabIndex = 14
- Top = 5760
- Width = 495
- End
- Begin VB.Label Label1
- Caption = "Ymin"
- Height = 255
- Index = 5
- Left = 3120
- TabIndex = 12
- Top = 5760
- Width = 495
- End
- Begin VB.Label Label1
- Caption = "Xmax"
- Height = 255
- Index = 4
- Left = 1560
- TabIndex = 10
- Top = 5760
- Width = 495
- End
- Begin VB.Label Label1
- Caption = "Xmin"
- Height = 255
- Index = 3
- Left = 0
- TabIndex = 8
- Top = 5760
- Width = 495
- End
- Begin MSComDlg.CommonDialog LoadDialog
- Left = 4680
- Top = 5280
- _version = 65536
- _extentx = 847
- _extenty = 847
- _stockprops = 0
- cancelerror = -1 'True
- End
- Begin VB.Label Label1
- Caption = "Phi"
- Height = 255
- Index = 2
- Left = 3240
- TabIndex = 5
- Top = 5400
- Width = 375
- End
- Begin VB.Label Label1
- Caption = "Theta"
- Height = 255
- Index = 1
- Left = 1440
- TabIndex = 3
- Top = 5400
- Width = 495
- End
- Begin VB.Label Label1
- Caption = "R"
- Height = 255
- Index = 0
- Left = 240
- TabIndex = 1
- Top = 5400
- Width = 255
- End
- Begin VB.Menu mnuFile
- Caption = "&File"
- Begin VB.Menu mnuFileLoad
- Caption = "&Load..."
- Shortcut = ^L
- End
- Begin VB.Menu mnuFileSep
- Caption = "-"
- End
- Begin VB.Menu mnuFileExit
- Caption = "E&xit"
- End
- End
- Attribute VB_Name = "ShowApfForm"
- Attribute VB_Creatable = False
- Attribute VB_Exposed = False
- Option Explicit
- ' Location of viewing eye.
- Dim EyeR As Single
- Dim EyeTheta As Single
- Dim EyePhi As Single
- Const Dtheta = PI / 20
- Const Dphi = PI / 20
- Const Dr = 1
- ' Location of focus point.
- Const FocusX = 0#
- Const FocusY = 0#
- Const FocusZ = 0#
- Dim Projector(1 To 4, 1 To 4) As Single
- Dim ThePicture As ObjPicture
- Dim ShowingParameters As Boolean
- ' *******************************************************
- ' Rotate the points in the cube and draw the cube.
- ' *******************************************************
- Private Sub DrawData(pic As Object)
- ' Prevent overflow errors when drawing lines
- ' too far out of bounds.
- On Error Resume Next
- ' Transform the points.
- ThePicture.ApplyFull Projector
- ' Display the data.
- pic.Cls
- ThePicture.Draw pic, EyeR
- pic.Refresh
- ' Display the viewnig parameters.
- ShowViewingParameters
- End Sub
- Sub ResetViewport()
- Dim xmin As Single
- Dim xmax As Single
- Dim ymin As Single
- Dim ymax As Single
- xmin = CSng(XminText.Text)
- xmax = CSng(XmaxText.Text)
- ymin = CSng(YminText.Text)
- ymax = CSng(YmaxText.Text)
- Pict.ScaleLeft = xmin
- Pict.ScaleWidth = xmax - xmin
- Pict.ScaleTop = ymax
- Pict.ScaleHeight = ymin - ymax
- Debug.Print Pict.ScaleLeft; Pict.ScaleWidth; Pict.ScaleTop; Pict.ScaleHeight
- DrawData Pict
- End Sub
- Sub ShowViewingParameters()
- ShowingParameters = True
- RText.Text = Format$(EyeR, "0.0000")
- ThetaText.Text = Format$(EyeTheta, "0.0000")
- PhiText.Text = Format$(EyePhi, "0.0000")
- RText.Refresh
- ThetaText.Refresh
- PhiText.Refresh
- ShowingParameters = False
- End Sub
- Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
- Select Case KeyCode
- Case vbKeyLeft
- EyeTheta = EyeTheta - Dtheta
-
- Case vbKeyRight
- EyeTheta = EyeTheta + Dtheta
-
- Case vbKeyUp
- EyePhi = EyePhi - Dphi
-
- Case vbKeyDown
- EyePhi = EyePhi + Dphi
-
- Case Else
- Exit Sub
- End Select
- m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
- DrawData Pict
- End Sub
- Private Sub Form_KeyPress(KeyAscii As Integer)
- Select Case KeyAscii
- Case Asc("+")
- EyeR = EyeR + Dr
-
- Case Asc("-")
- EyeR = EyeR - Dr
-
- Case Else
- Exit Sub
- End Select
- m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
- DrawData Pict
- End Sub
- Private Sub Form_Load()
- ' Initialize the eye position.
- EyeR = 10
- EyeTheta = PI * 0.2
- EyePhi = PI * 0.05
- ' Initialize the projection transformation.
- m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
- ' Create the data.
- CreateData
- ' Project and draw the data.
- DrawData Pict
- End Sub
- Sub CreateData()
- Dim pline As ObjPolyline
- Set ThePicture = New ObjPicture
- Set pline = New ObjPolyline
- ThePicture.objects.Add pline
- pline.AddSegment 0, 0, 0, 5, 0, 0
- pline.AddSegment 0, 0, 0, 0, 5, 0
- pline.AddSegment 0, 0, 0, 0, 0, 5
- End Sub
- Private Sub mnuFileExit_Click()
- Unload Me
- End Sub
- Private Sub mnuFileLoad_Click()
- Dim fname As String
- Dim filenum As Integer
- Dim txt As String
- Dim xmin As Single
- Dim ymin As Single
- Dim xmax As Single
- Dim ymax As Single
- ' Allow the user to pick a file.
- On Error Resume Next
- LoadDialog.filename = "*.APF"
- LoadDialog.ShowOpen
- If Err.Number = cdlCancel Then
- Unload LoadDialog
- Exit Sub
- ElseIf Err.Number <> 0 Then
- Unload LoadDialog
- Beep
- MsgBox "Error selecting file.", , vbExclamation
- Exit Sub
- End If
- On Error GoTo 0
- fname = LoadDialog.filename
- LoadDialog.InitDir = Left$(fname, Len(fname) _
- - Len(LoadDialog.FileTitle) - 1)
- ' Clear the picture.
- Set ThePicture = Nothing
- ' Open the file.
- filenum = FreeFile
- Open fname For Input As #filenum
- ' Make sure it's an Object Picture File.
- Input #filenum, txt
- If txt <> "3D APF PICTURE" Then
- Close filenum
- Beep
- MsgBox "Error reading file """ & fname & """.", , vbExclamation
- Exit Sub
- End If
- ' Read the picture.
- Set ThePicture = New ObjPicture
- ThePicture.FileInput filenum
- ' Close the file.
- Close filenum
- ' Refresh the display.
- DrawData Pict
- Caption = "Show APF [" & LoadDialog.FileTitle & "]"
- End Sub
- Private Sub PhiText_Change()
- If ShowingParameters Then Exit Sub
- EyePhi = CSng(PhiText.Text)
- m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
- DrawData Pict
- End Sub
- Private Sub RText_Change()
- If ShowingParameters Then Exit Sub
- EyeR = CSng(RText.Text)
- m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
- DrawData Pict
- End Sub
- Private Sub ThetaText_Change()
- If ShowingParameters Then Exit Sub
- EyeTheta = CSng(ThetaText.Text)
- m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
- DrawData Pict
- End Sub
- Private Sub XmaxText_Change()
- ResetViewport
- End Sub
- Private Sub XminText_Change()
- ResetViewport
- End Sub
- Private Sub YmaxText_Change()
- ResetViewport
- End Sub
- Private Sub YminText_Change()
- ResetViewport
- End Sub
-